home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / sound.swg / 0036_CDROM Player.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-05-26  |  23.0 KB  |  1,048 lines
  1. { Copyright 1993 by Michael W. Armstrong.
  2.                     2800 Skipwith Rd
  3.                     Richmond, VA 23294
  4.  
  5.   Compuserve ID 72740, 1145
  6.   This program is entered as Shareware.  If you find it useful, a small
  7.   donation would be appreciated.  Feel free to incorporate the code into
  8.   your own programs.
  9. }
  10.  
  11. {  NOTE : The CD_Vars and CDUNIT_P are at the end of this code }
  12.  
  13.  
  14. {$X+}
  15. program CDPlay;
  16.  
  17. {$IfDef Windows}
  18. {$C PRELOAD}
  19. uses CD_Vars, CDUnit_P, WinCRT, WinProcs;
  20. {$Else}
  21. uses CD_Vars, CDUnit_P, CRT, Drivers;
  22. {$EndIf}
  23.  
  24. Type
  25.   TotPlayRec = Record
  26.      Frames,
  27.      Seconds,
  28.      Minutes,
  29.      Nada     : Byte;
  30.   End;
  31.  
  32. Var
  33.   GoodDisk : Boolean;
  34.   SaveExit   : Pointer;
  35.   OldMode    : Word;
  36.   CurrentTrack,
  37.   StartTrack,
  38.   EndTrack   : Integer;
  39.   TotPlay    : TotPlayRec;
  40.   TrackInfo  : Array[1..99] of PAudioTrackInfo;
  41.  
  42. function LeadingZero(w: Word): String;
  43. var s: String;
  44. begin
  45.   Str(w:0, s);
  46.   LeadingZero := Copy('00', 1, 2 - Length(s)) + s;
  47. end;
  48.  
  49.  
  50. procedure DrawScreen;
  51. Const TStr = '%03d:%02d';
  52.       VStr = '%1d.%2d';
  53. Var   FStr : PChar;
  54.       NStr : String;
  55.       Param: Array[1..2] of LongInt;
  56.       Code : Integer;
  57. begin
  58.   WriteLn('CD ROM Audio Disk Player');
  59.   WriteLn('Copyright 1992 by M. W. ARMSTRONG');
  60.   Param[1] := MSCDEX_Version.Major;
  61.   Param[2] := MSCDEX_Version.Minor;
  62.  
  63. {$IfDef Windows}
  64.   wvsPrintf(FStr, VStr, Param);
  65. {$Else}
  66.   FormatStr(NStr, VStr, Param);
  67. {$EndIf}
  68.  
  69.   WriteLn('MSCDEX Version ', NStr);
  70.   Str(NumberOfCD, NStr);
  71.   WriteLn('Number of CD ROM Drives is: '+Nstr);
  72.   WriteLn('First CD Drive Letter is  : '+Chr(FirstCD+65));
  73.   WriteLn('There are ' + LeadingZero(EndTrack - StartTrack + 1) + ' Tracks on this disk');
  74.   Code := 1;
  75. end;
  76. {***********************************************************************}
  77.  
  78. {***********************************************************************}
  79.  
  80.  
  81. procedure Setup;
  82. Var
  83.   LeadOut,
  84.   StartP,
  85.   TotalPlayTime    : LongInt;
  86.   I     : Integer;
  87.   A,B,C : LongInt;
  88.   Track : Byte;
  89.   EA    : Array[1..4] of Byte;
  90.   SP,EP : LongInt;
  91.  
  92. Begin
  93.   FillChar(AudioDiskInfo, SizeOf(AudioDiskInfo), #0);
  94.   DeviceStatus;
  95.   If Audio THEN
  96.   Begin
  97.     Audio_Disk_Info;
  98.     TotalPlayTime := 0;
  99.     LeadOut := AudioDiskInfo.LeadOutTrack;
  100.  
  101.     StartTrack := AudioDiskInfo.LowestTrack;
  102.     EndTrack := AudioDiskInfo.HighestTrack;
  103.     CurrentTrack := StartTrack;
  104.     I := StartTrack-1;
  105.  
  106.     Repeat               { Checks if Audio Track or Data Track }
  107.         Inc(I);
  108.         Track := I;
  109.         Audio_Track_Info(StartP, Track);
  110.     Until (Track AND 64 = 0) OR (I = EndTrack);
  111.  
  112.     StartTrack := I;
  113.  
  114.     For I := StartTrack to EndTrack DO
  115.       Begin
  116.         Track := I;
  117.         Audio_Track_Info(StartP, Track);
  118.         New(TrackInfo[I]);
  119.         FillChar(TrackInfo[I]^, SizeOf(TrackInfo[I]^), #0);
  120.         TrackInfo[I]^.Track := I;
  121.         TrackInfo[I]^.StartPoint := StartP;
  122.         TrackInfo[I]^.TrackControl := Track;
  123.       End;
  124.  
  125.     For I := StartTrack to EndTrack - 1 DO
  126.         TrackInfo[I]^.EndPoint := TrackInfo[I+1]^.StartPoint;
  127.     TrackInfo[EndTrack]^.EndPoint := LeadOut;
  128.  
  129.     For I := StartTrack to EndTrack DO
  130.         Move(TrackInfo[I]^.EndPoint, TrackInfo[I]^.Frames, 4);
  131.  
  132.     TrackInfo[StartTrack]^.PlayMin := TrackInfo[StartTrack]^.Minutes;
  133.     TrackInfo[StartTrack]^.PlaySec := TrackInfo[StartTrack]^.Seconds - 2;
  134.  
  135.     For I := StartTrack + 1 to EndTrack DO
  136.       Begin
  137.         EP := (TrackInfo[I]^.Minutes * 60) + TrackInfo[I]^.Seconds;
  138.         SP := (TrackInfo[I-1]^.Minutes * 60) + TrackInfo[I-1]^.Seconds;
  139.         EP := EP - SP;
  140.         TrackInfo[I]^.PlayMin := EP DIV 60;
  141.         TrackInfo[I]^.PlaySec := EP Mod 60;
  142.       End;
  143.  
  144.     TotalPlayTime := AudioDiskInfo.LeadOutTrack - TrackInfo[StartTrack]^.StartPoint;
  145.     Move(TotalPlayTime, TotPlay, 4);
  146.   End;
  147. end;
  148.  
  149. {***********************************************************************}
  150.  
  151.  
  152. Begin
  153.   Setup;
  154.   If Audio THEN
  155.   If Playing THEN
  156.      StopAudio
  157.   ELSE
  158.      Begin
  159.        StopAudio;
  160.        Play_Audio(TrackInfo[StartTrack]^.StartPoint,
  161.              TrackInfo[EndTrack]^.EndPoint);
  162.        Audio_Status_Info;
  163.        DrawScreen;
  164.      End
  165.   ELSE
  166.       WriteLn('This is not an Audio CD');
  167.   WriteLn('UPC Code is: ', UPC_Code);
  168. end.
  169.  
  170. { -----------------------------------   CUT HERE --------------------   }
  171.  
  172. Unit CD_Vars;
  173.  
  174. Interface
  175.  
  176. Type
  177.   ListBuf    = Record
  178.     UnitCode : Byte;
  179.     UnitSeg,
  180.     UnitOfs  : Word;
  181.   end;
  182.   VTOCArray  = Array[1..2048] of Byte;
  183.   DriveByteArray = Array[1..128] of Byte;
  184.  
  185.   Req_Hdr    = Record
  186.      Len     : Byte;
  187.      SubUnit : Byte;
  188.      Command : Byte;
  189.      Status  : Word;
  190.      Reserved: Array[1..8] of Byte;
  191.   End;
  192.  
  193. Const
  194.   Init       = 0;
  195.   IoCtlInput = 3;
  196.   InputFlush = 7;
  197.   IOCtlOutput= 12;
  198.   DevOpen    = 13;
  199.   DevClose   = 14;
  200.   ReadLong   = 128;
  201.   ReadLongP  = 130;
  202.   SeekCmd    = 131;
  203.   PlayCD     = 132;
  204.   StopPlay   = 133;
  205.   ResumePlay = 136;
  206.  
  207. Type
  208.  
  209.   Audio_Play = Record
  210.     APReq    : Req_Hdr;
  211.     AddrMode : Byte;
  212.     Start    : LongInt;
  213.     NumSecs  : LongInt;
  214.   end;
  215.  
  216.   IOControlBlock = Record
  217.     IOReq_Hdr : Req_Hdr;
  218.     MediaDesc : Byte;
  219.     TransAddr : Pointer;
  220.     NumBytes  : Word;
  221.     StartSec  : Word;
  222.     ReqVol    : Pointer;
  223.     TransBlock: Array[1..130] OF Byte;
  224.   End;
  225.  
  226.   ReadControl = Record
  227.     IOReq_Hdr : Req_Hdr;
  228.     AddrMode  : Byte;
  229.     TransAddr : Pointer;
  230.     NumSecs   : Word;
  231.     StartSec  : LongInt;
  232.     ReadMode  : Byte;
  233.     IL_Size,
  234.     IL_Skip   : Byte;
  235.   End;
  236.  
  237.   AudioDiskInfoRec = Record
  238.     LowestTrack    : Byte;
  239.     HighestTrack   : Byte;
  240.     LeadOutTrack   : LongInt;
  241.   End;
  242.  
  243.   PAudioTrackInfo   = ^AudioTrackInfoRec;
  244.   AudioTrackInfoRec = Record
  245.     Track           : Integer;
  246.     StartPoint      : LongInt;
  247.     EndPoint        : LongInt;
  248.     Frames,
  249.     Seconds,
  250.     Minutes,
  251.     PlayMin,
  252.     PlaySec,
  253.     TrackControl    : Byte;
  254.   end;
  255.  
  256.   MSCDEX_Ver_Rec = Record
  257.     Major,
  258.     Minor       : Integer;
  259.   End;
  260.  
  261.   DirBufRec    = Record
  262.      XAR_Len   : Byte;
  263.      FileStart : LongInt;
  264.      BlockSize : Integer;
  265.      FileLen   : LongInt;
  266.      DT        : Byte;
  267.      Flags     : Byte;
  268.      InterSize : Byte;
  269.      InterSkip : Byte;
  270.      VSSN      : Integer;
  271.      NameLen   : Byte;
  272.      NameArray : Array[1..38] of Char;
  273.      FileVer   : Integer;
  274.      SysUseLen : Byte;
  275.      SysUseData: Array[1..220] of Byte;
  276.      FileName  : String[38];
  277.   end;
  278.  
  279.   Q_Channel_Rec = Record
  280.     Control     : Byte;
  281.     Track       : Byte;
  282.     Index       : Byte;
  283.     Minutes     : Byte;
  284.     Seconds     : Byte;
  285.     Frame       : Byte;
  286.     Zero        : Byte;
  287.     AMinutes    : Byte;
  288.     ASeconds    : Byte;
  289.     AFrame      : Byte;
  290.   End;
  291.  
  292. Var
  293.   AudioChannel   : Array[1..9] of Byte;
  294.   RedBook,
  295.   Audio,
  296.   DoorOpen,
  297.   DoorLocked,
  298.   AudioManip,
  299.   DiscInDrive    : Boolean;
  300.   AudioDiskInfo  : AudioDiskInfoRec;
  301.   DriverList     : Array[1..26] of ListBuf;
  302.   NumberOfCD     : Integer;
  303.   FirstCD        : Integer;
  304.   UnitList       : Array[1..26] of Byte;
  305.   MSCDEX_Version : MSCDEX_Ver_Rec;
  306.   QChannelInfo   : Q_Channel_Rec;
  307.   Busy,
  308.   Playing,
  309.   Paused         : Boolean;
  310.   Last_Start,
  311.   Last_End       : LongInt;
  312.   DirBuf         : DirBufRec;
  313.  
  314. Implementation
  315.  
  316. Begin
  317.   FillChar(DriverList, SizeOf(DriverList), #0);
  318.   FillChar(UnitList, SizeOf(UnitList), #0);
  319.   NumberOfCD  := 0;
  320.   FirstCD  := 0;
  321.   MSCDEX_Version.Major := 0;
  322.   MSCDEX_Version.Minor := 0;
  323. end.
  324.  
  325. { -----------------------------------   CUT HERE --------------------   }
  326.  
  327. {$X+}
  328.  
  329. Unit CDUnit_P;
  330.  
  331. Interface
  332.  
  333. {Include the appropriate units.}
  334.  
  335. {$IfDef Windows}
  336. {$C PRELOAD}
  337. Uses Strings, WinCRT, WinDOS, WinProcs, SimRMI, CD_Vars;
  338. {$EndIf}
  339. {$IfDef DPMI}
  340. Uses Strings, CRT, DOS, WinAPI, SimRMI, CD_Vars;
  341. {$EndIf}
  342. {$IfDef MSDOS}
  343. Uses Strings, CRT, DOS, CD_Vars;
  344. {$EndIf}
  345.  
  346. Var
  347.   Drive   : Integer;  { Must set drive before all operations }
  348.   SubUnit : Integer;
  349.  
  350. function File_Name(var Code : Integer) : String;
  351.  
  352. function Read_VTOC(var VTOC : VTOCArray;
  353.                    var Index : Integer) : Boolean;
  354.  
  355. procedure CD_Check(var Code : Integer);
  356.  
  357. procedure Vol_Desc(Var Code : Integer;
  358.                    var ErrCode : Integer);
  359.  
  360. procedure Get_Dir_Entry(PathName : String;
  361.                         var Format, ErrCode : Integer);
  362.  
  363. procedure DeviceStatus;
  364.  
  365. procedure Audio_Channel_Info;
  366.  
  367. procedure Audio_Disk_Info;
  368.  
  369. procedure Audio_Track_Info(Var StartPoint : LongInt;
  370.                            Var TrackControl : Byte);
  371.  
  372. procedure Audio_Status_Info;
  373.  
  374. procedure Q_Channel_Info;
  375.  
  376. procedure Lock(LockDrive : Boolean);
  377.  
  378. procedure Reset;
  379.  
  380. procedure Eject;
  381.  
  382. procedure CloseTray;
  383.  
  384. procedure Resume_Play;
  385.  
  386. procedure Pause_Audio;
  387.  
  388. procedure Play_Audio(StartSec, EndSec : LongInt);
  389.  
  390. function StopAudio : Boolean;
  391.  
  392. function Sector_Size(ReadMode : Byte) : Word;
  393.  
  394. function Volume_Size : LongInt;
  395.  
  396. function Media_Changed : Boolean;
  397.  
  398. function Head_Location(AddrMode : Byte) : LongInt;
  399.  
  400. procedure Read_Drive_Bytes(Var ReadBytes : DriveByteArray);
  401.  
  402. function UPC_Code : String;
  403.  
  404. Implementation
  405.  
  406. Const
  407.   CarryFlag  = $0001;
  408.  
  409. Var
  410. {$IfDef MSDOS}
  411.   Regs       : Registers;
  412. {$Else}
  413.   Regs       :TRealModeRecord; { from SimRMI Unit }
  414. {$EndIf}
  415.   DOSOffset,
  416.   DOSSegment,
  417.   DOSSelector:Word;
  418.   AllocateLong:Longint;
  419.   IOBlock    : Pointer;
  420.  
  421.  
  422. {$IfDef MSDOS}
  423. { standard DOS routines for segments and pointers }
  424. function GetIOBlock(var Block : Pointer; Size : Word) : Boolean;
  425. begin
  426.   GetMem(Block, Size);
  427.   DOSSegment := Seg(Block^);
  428.   DOSOffset := Ofs(Block^);
  429.   GetIOBlock := TRUE;
  430. end;
  431.  
  432. function FreeIOBlock(var Block: Pointer) : Boolean;
  433. begin
  434.   FreeMem(Block, SizeOf(Block^));
  435.   DOSSegment := 0;
  436.   DOSSelector := 0;
  437.   DOSOffset := 0;
  438.   FreeIOBlock := TRUE;
  439. end;
  440.  
  441. {$ELSE}
  442.  
  443. { Get a block in DOS and set pointer values.  DOSSelector is used
  444.   to access the block under protected mode.  DOSSegment accesses the
  445.   block in real mode }
  446.  
  447. function GetIOBlock(var Block : Pointer; Size : Word) : Boolean;
  448. begin
  449.   AllocateLong:=GlobalDOSAlloc(Size); { enough extra room for string }
  450.   If AllocateLong<>0 Then  {If allocation was successful...}
  451.   Begin
  452.      DOSSegment:=AllocateLong SHR 16;     {Get the real mode segment of the memory}
  453.      DOSSelector:=AllocateLong AND $FFFF; {Get the protected mode selector of the memory}
  454.      DOSOffset := 0;
  455.      Block := Ptr(DOSSelector, 0);
  456.      GetIOBlock := TRUE;
  457.   End
  458.   ELSE
  459.      GetIOBlock := FALSE;
  460. end;
  461.  
  462. { Free the DOS block and dereference the pointer }
  463.  
  464. function FreeIOBlock(var Block: Pointer) : Boolean;
  465. begin
  466.   DOSSelector := GlobalDOSFree(DOSSelector);
  467.   DOSSegment := 0;
  468.   Block := NIL;
  469.   FreeIOBlock := (DOSSelector = 0);
  470. end;
  471.  
  472. {$EndIf}
  473.  
  474. procedure Clear_Regs;
  475. begin
  476.   FillChar(Regs, SizeOf(Regs), #0);
  477. end;
  478.  
  479. procedure CD_Intr;
  480. begin
  481.   Regs.AH := $15;
  482.  
  483. {$IfDef MSDOS}
  484.   Intr($2F, Regs);  { Call DOS normally }
  485. {$Else}
  486.   If NOT SimRealModeInt($2F,@Regs) Then    {Call DOS through the DPMI}
  487.      Halt(100);
  488. {$EndIf}
  489. end;
  490.  
  491. procedure MSCDEX_Ver;
  492. begin
  493.   Clear_Regs;
  494.   Regs.AL := $0C;
  495.   Regs.BX := $0000;
  496.   CD_Intr;
  497.   MSCDEX_Version.Minor := 0;
  498.   If Regs.BX = 0 Then
  499.      MSCDEX_Version.Major := 1
  500.   ELSE
  501.      Begin
  502.        MSCDEX_Version.Major := Regs.BH;
  503.        MSCDEX_Version.Minor := Regs.BL;
  504.      End;
  505. end;
  506.  
  507. procedure Initialize;
  508. begin
  509.   NumberOfCD := 0;
  510.   Clear_Regs;
  511.   Regs.AL := $00;
  512.   Regs.BX := $0000;
  513.   CD_Intr;
  514.   If Regs.BX <> 0 THEN
  515.      Begin
  516.        NumberOfCD := Regs.BX;
  517.        FirstCD := Regs.CX;
  518.        Clear_Regs;
  519.        FillChar(DriverList, SizeOf(DriverList), #0);
  520.        FillChar(UnitList, SizeOf(UnitList), #0);
  521.        Regs.AL := $01;               { Get List of Driver Header Addresses }
  522.        Regs.ES := Seg(DriverList);
  523.        Regs.BX := Ofs(DriverList);
  524.        CD_Intr;
  525.        Clear_Regs;
  526.        Regs.AL := $0D;               { Get List of CD-ROM Units }
  527.        Regs.ES := Seg(UnitList);
  528.        Regs.BX := Ofs(UnitList);
  529.        CD_Intr;
  530.        MSCDEX_Ver;
  531.      End;
  532. end;
  533.  
  534.  
  535. function File_Name(var Code : Integer) : String;
  536. Var
  537.   FN : Pointer;
  538. begin
  539.   Clear_Regs;
  540.   If NOT GetIOBlock(FN, 64) THEN
  541.      Exit;
  542.   FillChar(FN, SizeOf(FN), #0);
  543.   Regs.AL := Code + 1;
  544. {
  545.        Copyright Filename     =  1
  546.        Abstract Filename      =  2
  547.        Bibliographic Filename =  3
  548. }
  549.   Regs.CX := Drive;
  550.   Regs.ES := DOSSegment;
  551.   Regs.BX := DOSOffset;
  552.   CD_Intr;
  553.   Code := Regs.AX;
  554.   If (Regs.Flags AND CarryFlag) = 0 THEN
  555.      File_Name := StrPas(FN)
  556.   ELSE
  557.      File_Name := '';
  558.   FreeIOBlock(FN);
  559. end;
  560.  
  561.  
  562. function Read_VTOC(var VTOC : VTOCArray;
  563.                    var Index : Integer) : Boolean;
  564. { On entry -
  565.      Index = Vol Desc Number to read from 0 to ?
  566.   On return
  567.      Case Index of
  568.             1    : Standard Volume Descriptor
  569.             $FF  : Volume Descriptor Terminator
  570.             0    : All others
  571. }
  572. var
  573.   PVTOC : Pointer;
  574.  
  575. begin
  576.   Clear_Regs;
  577.   If NOT GetIOBlock(PVTOC, SizeOf(VTOCArray)) THEN
  578.      Exit;
  579.   FillChar(PVTOC^, SizeOf(PVTOC^), #0);
  580.   Regs.AL := $05;
  581.   Regs.CX := Drive;
  582.   Regs.DX := Index;
  583.   Regs.ES := DOSSegment;
  584.   Regs.BX := DOSOffset;
  585.   CD_Intr;
  586.   Index := Regs.AX;
  587.   Move(PVTOC^,VTOC, SizeOf(VTOC));
  588.   If (Regs.Flags AND CarryFlag) = 0 THEN
  589.      Read_VTOC := TRUE
  590.   ELSE
  591.      Read_VTOC := FALSE;
  592.   FreeIOBlock(PVTOC);
  593. end;
  594.  
  595. procedure CD_Check(var Code : Integer);
  596. begin
  597.   Clear_Regs;
  598.   Regs.AL := $0B;
  599.   Regs.BX := $0000;
  600.   Regs.CX := Drive;
  601.   CD_Intr;
  602.   If Regs.BX <> $ADAD THEN
  603.      Code := 2
  604.   ELSE
  605.      Begin
  606.        If Regs.AX <> 0 THEN
  607.           Code := 0
  608.        ELSE
  609.           Code := 1;
  610.      End;
  611. end;
  612.  
  613.  
  614. procedure Vol_Desc(Var Code : Integer;
  615.                    var ErrCode : Integer);
  616.  
  617.   function Get_Vol_Desc : Byte;
  618.     begin
  619.       Clear_Regs;
  620.       Regs.CX := Drive;
  621.       Regs.AL := $0E;
  622.       Regs.BX := $0000;
  623.       CD_Intr;
  624.       Code := Regs.AX;
  625.       If (Regs.Flags AND CarryFlag) <> 0 THEN
  626.          ErrCode := $FF;
  627.       Get_Vol_Desc := Regs.DH;
  628.     end;
  629.  
  630. begin
  631.   Clear_Regs;
  632.   ErrCode := 0;
  633.   If Code <> 0 THEN
  634.      Begin
  635.        Regs.DH := Code;
  636.        Regs.DL := 0;
  637.        Regs.BX := $0001;
  638.        Regs.AL := $0E;
  639.        Regs.CX := Drive;
  640.        CD_Intr;
  641.        Code := Regs.AX;
  642.        If (Regs.Flags AND CarryFlag) <> 0 THEN
  643.           ErrCode := $FF;
  644.      End;
  645.   If ErrCode = 0 THEN
  646.      Code := Get_Vol_Desc;
  647. end;
  648.  
  649. procedure Get_Dir_Entry(PathName : String;
  650.                         var Format, ErrCode : Integer);
  651. var
  652.   PN : PChar;
  653.   DB : Pointer;
  654. begin
  655.   FillChar(DirBuf, SizeOf(DirBuf), #0);
  656.   PathName := PathName + #0;
  657.   If NOT GetIOBlock(DB, SizeOf(DirBufRec) + 256) THEN
  658.      Exit;
  659.   PN := Ptr(DOSSelector, SizeOf(DirBufRec) + 1);
  660.   Clear_Regs;
  661.   Regs.AL := $0F;
  662.   Regs.CL := Drive;
  663.   Regs.CH := 1;
  664.   Regs.ES := DOSSegment;
  665.   Regs.BX := SizeOf(DirBufRec) + 1;
  666.   Regs.SI := DOSSegment;
  667.   Regs.DI := DOSOffset;
  668.   CD_Intr;
  669.   ErrCode := Regs.AX;
  670.   If (Regs.Flags AND CarryFlag) = 0 THEN
  671.   Begin
  672.     Move(DB^, DirBuf, SizeOf(DirBuf));
  673.     Move(DirBuf.NameArray[1], DirBuf.FileName[1], 38);
  674.     DirBuf.FileName[0] := #12; { File names are only 8.3 }
  675.     Format := Regs.AX
  676.   End
  677.   ELSE
  678.     Format := $FF;
  679.   FreeIOBlock(DB);
  680. end;
  681.  
  682. function IO_Control(Command, NumberOfBytes, TransferBytes,
  683.                      ReturnBytes, StartPoint : Byte;
  684.                      var Bytes, TransferBlock): Byte;
  685. var
  686.   I : Word;
  687. begin
  688.   If NOT GetIOBlock(IOBlock, SizeOf(IOControlBlock)) THEN
  689.      Exit;
  690.   With IOControlBlock(IOBlock^) DO
  691.   Begin
  692.     I := Ofs(TransBlock[1]) - Ofs(IOReq_Hdr);
  693.     NumBytes := NumberOfBytes;
  694.     IOReq_Hdr.Len := 26;
  695.     IOReq_Hdr.SubUnit := SubUnit;
  696.     IOReq_Hdr.Status := 0;
  697.     TransAddr := Ptr(DOSSegment, I); { 23 bytes into the IOBlock^ }
  698.     IOReq_Hdr.Command := Command;
  699.     Move(Bytes, TransBlock[1], TransferBytes);
  700.     Clear_Regs;
  701.     Regs.AL := $10;
  702.     Regs.CX := Drive;
  703.     Regs.ES := DOSSegment;
  704.     Regs.BX := DOSOffset;
  705.     CD_Intr;
  706.     Busy := (IOReq_Hdr.Status AND 512) <> 0;
  707.     If ((IOReq_Hdr.Status AND 32768) <> 0) THEN
  708.        I := IOReq_Hdr.Status AND $FF
  709.     ELSE
  710.         I := 0;
  711.     If ReturnBytes <> 0 THEN
  712.        Move(TransBlock[StartPoint], TransferBlock, ReturnBytes);
  713.   End;
  714.   IO_Control := I;
  715.   FreeIOBlock(IOBlock);
  716. end;
  717.  
  718. procedure Audio_Channel_Info;
  719. var
  720.   Bytes : Byte;
  721. begin
  722.   Bytes := 4;
  723.   IO_Control(IOCtlInput, 9, 1, 9, 1, Bytes, AudioChannel);
  724. End;
  725.  
  726. procedure DeviceStatus;
  727. var
  728.   Bytes : Array[1..2] OF Byte;
  729.   Status: Word;
  730. begin
  731.   Bytes[1] := 6;
  732.  
  733.   IO_Control(IOCtlInput, 5, 1, 2, 2, Bytes, Bytes);
  734.   Move(Bytes, Status, 2);
  735.  
  736.   DoorOpen     := Status AND 1 <> 0;
  737.   DoorLocked   := Status AND 2 = 0;
  738.   Audio        := Status AND 16 <> 0;
  739.   AudioManip   := Status AND 256 <> 0;
  740.   DiscInDrive  := Status AND 2048 = 0;
  741.   RedBook      := Status AND 1024 <> 0;
  742. End;
  743.  
  744. procedure Audio_Disk_Info;
  745. var Bytes : Byte;
  746. begin
  747.   Bytes := 10;
  748.   IO_Control(IOCtlInput, 7, 1, 6, 2, Bytes, AudioDiskInfo);
  749.   Playing := Busy;
  750. end;
  751.  
  752. procedure Audio_Track_Info(Var StartPoint : LongInt;
  753.                            Var TrackControl : Byte);
  754. var
  755.   Bytes : Array[1..5] Of BYTE;
  756. begin
  757.   Bytes[1] := 11;
  758.   Bytes[2] := TrackControl;   { Track number }
  759.  
  760.   IO_Control(IOCtlInput, 7, 2, 5, 3, Bytes, Bytes);
  761.   Move(Bytes[1], StartPoint, 4);
  762.   TrackControl := Bytes[5];
  763.  
  764.   Playing := Busy;
  765. end;
  766.  
  767. procedure Q_Channel_Info;
  768. var
  769.   Bytes : Byte;
  770. begin
  771.   Bytes := 12;
  772.   IO_Control(IOCtlInput, 11, 1, 11, 2, Bytes, QChannelInfo);
  773. end;
  774.  
  775. procedure Audio_Status_Info;
  776. var
  777.   Bytes : Array[1..11] Of Byte;
  778. begin
  779.   Bytes[1] := 15;
  780.   IO_Control(IOCtlInput, 11, 1, 8, 2, Bytes, Bytes);
  781.   Paused := (Word(Bytes[2]) AND 1) <> 0;
  782.   Move(Bytes[4], Last_Start, 4);
  783.   Move(Bytes[8], Last_End, 4);
  784.   Playing := Busy;
  785. end;
  786.  
  787. procedure Eject;
  788. var
  789.   Bytes : Byte;
  790. begin
  791.   Bytes := 0;
  792.   IO_Control(IOCtlOutput, 1, 1, 0, 0, Bytes, Bytes);
  793. end;
  794.  
  795. procedure Reset;
  796. var Bytes : Byte;
  797. begin
  798.   Bytes := 2;
  799.   IO_Control(IOCtlOutput, 1, 1, 0, 0, Bytes, Bytes);
  800.   Busy := TRUE;
  801. end;
  802.  
  803. procedure Lock(LockDrive : Boolean);
  804. var
  805.   Bytes : Array[1..2] Of Byte;
  806. begin
  807.   Bytes[1] := 1;
  808.   If LockDrive THEN
  809.      Bytes[2] := 1
  810.   ELSE
  811.      Bytes[2] := 0;
  812.   IO_Control(IOCtlOutput, 2, 2, 0, 0, Bytes, Bytes);
  813. end;
  814.  
  815. procedure CloseTray;
  816. var Bytes : Byte;
  817. begin
  818.   Bytes := 5;
  819.   IO_Control(IOCtlOutput, 1, 1, 0, 0, Bytes, Bytes);
  820. end;
  821.  
  822. Var
  823.   AudioPlay : Pointer;
  824.  
  825.  
  826. function Play(StartLoc, NumSec : LongInt) : Boolean;
  827. begin
  828.  
  829.   If NOT GetIOBlock(AudioPlay, SizeOf(Audio_Play)) THEN
  830.      Exit;
  831.   With Audio_Play(AudioPlay^) DO
  832.   Begin
  833.     APReq.Command := PlayCD;
  834.     APReq.Len := 22;
  835.     APReq.SubUnit := SubUnit;
  836.     Start := StartLoc;
  837.     NumSecs := NumSec;
  838.     AddrMode := 1;
  839.     Regs.AL := $10;
  840.     Regs.CX := Drive;
  841.     Regs.ES := DOSSegment;
  842.     Regs.BX := DOSOffset;
  843.     CD_Intr;
  844.     Play := ((APReq.Status AND 32768) = 0);
  845.   End;
  846.   FreeIOBlock(AudioPlay);
  847. end;
  848.  
  849. procedure Play_Audio(StartSec, EndSec : LongInt);
  850. Var
  851.   SP,
  852.   EP     : LongInt;
  853.   SArray : Array[1..4] Of Byte;
  854.   EArray : Array[1..4] Of Byte;
  855. begin
  856.   Move(StartSec, SArray[1], 4);
  857.   Move(EndSec, EArray[1], 4);
  858.   SP := SArray[3];           { Must use longint or get negative result }
  859.   SP := (SP*75*60) + (SArray[2]*75) + SArray[1];
  860.   EP := EArray[3];
  861.   EP := (EP*75*60) + (EArray[2]*75) + EArray[1];
  862.   EP := EP-SP;
  863.  
  864.   Playing := Play(StartSec, EP);
  865.   Audio_Status_Info;
  866. end;
  867.  
  868. procedure Pause_Audio;
  869. begin
  870.  
  871.   If Playing THEN
  872.      Begin
  873.        If NOT GetIOBlock(AudioPlay, SizeOf(Audio_Play)) THEN
  874.           Exit;
  875.        With Audio_Play(AudioPlay^) DO
  876.        Begin
  877.          APReq.Command := StopPlay;
  878.          APReq.Len := 13;
  879.          APReq.SubUnit := SubUnit;
  880.        End;
  881.        Regs.AL := $10;
  882.        Regs.CX := Drive;
  883.        Regs.ES := DOSSegment;
  884.        Regs.BX := DOSOffset;
  885.        CD_Intr;
  886.        FreeIOBlock(AudioPlay);
  887.      end;
  888.   Audio_Status_Info;
  889.   Playing := FALSE;
  890. end;
  891.  
  892. procedure Resume_Play;
  893. begin
  894.   If NOT GetIOBlock(AudioPlay, SizeOf(Audio_Play)) THEN
  895.      Exit;
  896.   With Audio_Play(AudioPlay^) DO
  897.   Begin
  898.     APReq.Command := ResumePlay;
  899.     APReq.Len := 13;
  900.     APReq.SubUnit := SubUnit;
  901.   End;
  902.   Regs.AL := $10;
  903.   Regs.CX := Drive;
  904.   Regs.ES := DOSSegment;
  905.   Regs.BX := DOSOffset;
  906.   CD_Intr;
  907.   Audio_Status_Info;
  908.   FreeIOBlock(AudioPlay); { free DOS block anbd dereference pointer }
  909. end;
  910.  
  911. function StopAudio : Boolean;
  912. begin
  913.  
  914.   If NOT GetIOBlock(AudioPlay, SizeOf(Audio_Play)) THEN
  915.      Exit;
  916.   With Audio_Play(AudioPlay^) DO
  917.   Begin
  918.     APReq.Command := StopPlay;
  919.     APReq.Len := 13;
  920.     APReq.SubUnit := SubUnit;
  921.     Regs.AL := $10;
  922.     Regs.CX := Drive;
  923.     Regs.ES := DOSSegment;
  924.     Regs.BX := DOSOffset;
  925.     CD_Intr;
  926.     StopAudio := ((APReq.Status AND 32768) = 0);
  927.   End;
  928.   FreeIOBlock(AudioPlay);
  929. end;
  930.  
  931. function Sector_Size(ReadMode : Byte) : Word;
  932. Var
  933.   SecSize : Word;
  934.   Bytes   : Array[1..2] Of Byte;
  935. begin
  936.   Bytes[1] := 7;
  937.   Bytes[2] := ReadMode;
  938.   IO_Control(IOCtlInput, 4, 2, 2, 3, Bytes, SecSize);
  939.   Sector_Size := SecSize;
  940. End;
  941.  
  942. function Volume_Size : LongInt;
  943. Var
  944.   VolSize : LongInt;
  945.   Bytes   : Byte;
  946. begin
  947.   Bytes := 8;
  948.   IO_Control(IOCtlInput, 5, 1, 4, 2, Bytes, VolSize);
  949.   Volume_Size := VolSize;
  950. End;
  951.  
  952. function Media_Changed : Boolean;
  953.  
  954. {  1  :  Media not changed
  955.    0  :  Don't Know
  956.   -1  :  Media changed
  957. }
  958. var
  959.   MedChng : Byte;
  960.   Bytes : Byte;
  961. begin
  962.   Bytes := 9;
  963.   IO_Control(IOCtlInput, 2, 1, 4, 2, Bytes, MedChng);
  964.   Inc(MedChng);
  965.   If MedChng IN [1,0] THEN
  966.      Media_Changed := True
  967.   ELSE
  968.      Media_Changed := False;
  969. End;
  970.  
  971. function Head_Location(AddrMode : Byte) : LongInt;
  972. Var
  973.   HeadLoc : Longint;
  974.   Bytes : Array[1..2] Of Byte;
  975. begin
  976.   Bytes[1] := 1;
  977.   Bytes[2] := AddrMode;
  978.   IO_Control(IOCtlInput, 6, 2, 4, 3, Bytes, HeadLoc);
  979.   Head_Location := HeadLoc;
  980. End;
  981.  
  982. procedure Read_Drive_Bytes(Var ReadBytes : DriveByteArray);
  983. var
  984.   Bytes : Byte;
  985. Begin
  986.   Bytes := 5;
  987.   IO_Control(IOCtlInput, 130, 1, 128, 3, Bytes, ReadBytes);
  988. End;
  989.  
  990. function UPC_Code : String;
  991. Var
  992.   I, J, K : Integer;
  993.   TempStr : String;
  994.   Bytes : Array[1..11] Of Byte;
  995. Begin
  996.   TempStr := '';
  997.   FillChar(Bytes, SizeOf(Bytes), #0);
  998.   Bytes[1] := 14;
  999.   If (IO_Control(IOCtlInput, 11, 1, 11, 1, Bytes, Bytes) <> 0) THEN
  1000.      TempStr := 'No UPC Code'
  1001.   ELSE
  1002.   Begin
  1003.     For I := 3 to 9 DO
  1004.       Begin
  1005.         J := (Bytes[I] AND $F0) SHR 4;
  1006.         K := Bytes[I] AND $0F;
  1007.         TempStr := TempStr + Chr(J + 48);
  1008.         TempStr := TempStr + Chr(K + 48);
  1009.       End;
  1010.     If Length(TempStr) > 13 THEN
  1011.         TempStr := Copy(TempSTr, 1, 13);
  1012.   End;
  1013.   UPC_Code := TempStr;
  1014. End;
  1015.  
  1016. {************************************************************}
  1017. {$IfDef MSDOS}
  1018. {$ELSE}
  1019. {$F+}
  1020. var
  1021.   ExitRoutine : Pointer;
  1022. procedure MyExit;
  1023. begin
  1024.   ExitProc := ExitRoutine;
  1025.   If DOSSelector <> 0 THEN
  1026.   Begin
  1027.      GlobalDOSFree(DOSSelector);
  1028.      WriteLn('DOS Selector not free');
  1029.   End
  1030.   ELSE
  1031.      WriteLn('DOS Selector free');
  1032. end;
  1033. {$EndIf}
  1034.  
  1035. Begin
  1036.   NumberOfCD := 0;
  1037.   FirstCD := 0;
  1038.   FillChar(MSCDEX_Version, SizeOf(MSCDEX_Version), #0);
  1039.   Initialize;
  1040.   Drive := FirstCD;
  1041.   SubUnit := 0;
  1042. {$IfDef MSDOS}
  1043. {$ELSE}
  1044.   ExitRoutine := ExitProc;
  1045.   ExitProc := @MyExit;
  1046. {$EndIf}
  1047. End.
  1048.